home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / bin / tknewsbiff < prev    next >
Text File  |  1995-07-21  |  11KB  |  512 lines
  1. #!/usr/skunk/bin/expectk --
  2.  
  3. # Name: tknewsbiff
  4. # Author: Don Libes
  5. # Version: 1.1
  6. # Written: January 1, 1994
  7.  
  8. # Description: When unread news appears in your favorite groups, pop up
  9. # a little window describing which newsgroups and how many articles.
  10. # Go away when articles are no longer unread.
  11. # Optionally, run a UNIX program (to play a sound, read news, etc.)
  12.  
  13. # Default config file in ~/.tknewsbiff[-host]
  14.  
  15. # These two procedures are needed because Tk provides no command to undo
  16. # the "wm unmap" command.  You must remember whether it was iconic or not.
  17. # PUBLIC
  18. proc unmapwindow {} {
  19.     global _window_open
  20.  
  21.     switch [wm state .] \
  22.     iconic {
  23.         set _window_open 0
  24.     } normal {
  25.         set _window_open 1
  26.     }
  27.     wm withdraw .
  28. }
  29. unmapwindow
  30. # window state starts out as "iconic" before it is mapped, Tk bug?
  31. # make sure that when we map it, it will be open (i.e., "normal")
  32. set _window_open 1
  33.  
  34. # PUBLIC
  35. proc mapwindow {} {
  36.     global _window_open
  37.  
  38.     if $_window_open {
  39.         wm deiconify .
  40.     } else {
  41.         wm iconify .
  42.     }
  43. }
  44.  
  45. proc _abort {msg} {
  46.     global argv0
  47.  
  48.     puts "$argv0: $msg"
  49.     exit 1
  50. }
  51.  
  52. if [info exists env(DOTDIR)] {
  53.     set home $env(DOTDIR)
  54. } else {
  55.     set home [glob ~]
  56. }
  57.  
  58. set delay          60
  59. set width          27
  60. set height          10
  61. set _default_config_file  $home/.tknewsbiff
  62. set _config_file      $_default_config_file
  63. set _default_server      news
  64. set server          $_default_server
  65. set server_timeout      60
  66.  
  67. log_user 0
  68.  
  69. listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1
  70. scrollbar .scrollbar -command ".list yview" -relief raised
  71. pack .scrollbar -side left -fill y
  72. pack .list -side left -fill both -expand 1
  73.  
  74. while {[llength $argv]>0} {
  75.     set arg [lindex $argv 0]
  76.  
  77.     if [file readable $arg] {
  78.         if 0==[string compare active [file tail $arg]] {
  79.             set active_file $arg
  80.             set argv [lrange $argv 1 end]
  81.         } else {
  82.             # must be a config file
  83.             set _config_file $arg
  84.             set argv [lrange $argv 1 end]
  85.         }
  86.     } elseif {[file readable $_config_file-$arg]} {
  87.         # maybe it's a hostname suffix for a newsrc file?
  88.         set _config_file $_default_config_file-$arg
  89.         set argv [lrange $argv 1 end]
  90.     } else {
  91.         # maybe it's just a hostname for regular newsrc file?
  92.         set server $arg
  93.         set argv [lrange $argv 1 end]
  94.     }
  95. }
  96.  
  97. proc _read_config_file {} {
  98.     global _config_file argv0 watch_list ignore_list
  99.  
  100.     # remove previous user-provided proc in case user simply
  101.     # deleted it from config file
  102.     proc user {} {}
  103.  
  104.     set watch_list {}
  105.     set ignore_list {}
  106.  
  107.     if [file exists $_config_file] {
  108.         # uplevel allows user to set global variables
  109.         if [catch {uplevel source $_config_file} msg] {
  110.             _abort "error reading $_config_file\n$msg"
  111.         }
  112.     }
  113.  
  114.     if [llength $watch_list]==0 {
  115.         watch *
  116.     }
  117. }
  118.  
  119. # PUBLIC
  120. proc watch {args} {
  121.     global watch_list
  122.  
  123.     lappend watch_list $args
  124. }
  125.  
  126. # PUBLIC
  127. proc ignore {ng} {
  128.     global ignore_list
  129.  
  130.     lappend ignore_list $ng
  131. }
  132.  
  133. # get time and server
  134. _read_config_file
  135.  
  136. # if user didn't set newsrc, try ~/.newsrc-server convention.
  137. # if that fails, fall back to just plain ~/.newsrc
  138. if ![info exists newsrc] {
  139.     set newsrc $home/.newsrc-$server
  140.     if ![file readable $newsrc] {
  141.         set newsrc $home/.newsrc
  142.         if ![file readable $newsrc] {
  143.             _abort "cannot tell what newgroups you read
  144. found neither $home/.newsrc-$server nor $home/.newsrc"
  145.         }
  146.     }
  147. }
  148.  
  149. # PRIVATE
  150. proc _read_newsrc {} {
  151.     global db newsrc
  152.  
  153.     if [catch {set file [open $newsrc]} msg] {
  154.         _abort $msg
  155.     }
  156.     while {-1 != [gets $file buf]} {
  157.         if [regexp "!" $buf] continue
  158.         if [regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen] {
  159.             set db($ng,seen) $seen
  160.         }
  161.         # only way 2nd regexp can fail is on lines
  162.         # that have a : but no number
  163.     }
  164.     close $file
  165. }
  166.  
  167. proc _unknown_host {} {
  168.     global server _default_server
  169.  
  170.     if 0==[string compare $_default_server $server] {
  171.         puts "tknewsbiff: default server <$server> is not known"
  172.     } else {
  173.         puts "tknewsbiff: server <$server> is not known"
  174.     }
  175.  
  176.     puts "Give tknewsbiff an argument - either the name of your news server
  177. or active file.  I.e.,
  178.  
  179.     tknewsbiff news.nist.gov
  180.     tknewsbiff /usr/news/lib/active
  181.  
  182. If you have a correctly defined configuration file (.tknewsbiff),
  183. an argument is not required.  See the man page for more info."
  184.     exit 1
  185. }
  186.  
  187. # read active file
  188. # PRIVATE
  189. proc _read_active {} {
  190.     global db server active_list active_file
  191.     upvar #0 server_timeout timeout
  192.  
  193.     set active_list {}
  194.  
  195.     if [info exists active_file] {
  196.         spawn -open [open $active_file]
  197.     } else {
  198.         spawn telnet $server nntp
  199.         expect {
  200.             "20*\n" {
  201.                 # should get 200 or 201
  202.             } "NNTP server*\n" {
  203.                 puts "tknewsbiff: unexpected response from server:"
  204.                 puts "$expect_out(buffer)"
  205.                 return 1
  206.             } "unknown host" {
  207.                 _unknown_host
  208.             } timeout {
  209.                 close
  210.                 wait
  211.                 return 1
  212.             } eof {
  213.                 # loadav too high probably
  214.                 wait
  215.                 return 1
  216.             }
  217.         }
  218.         exp_send "list\r"
  219.         expect "list\r\n"    ;# ignore echo of "list" command
  220.         expect -re "215\[^\n]*\n" ;# skip "Newsgroups in form" line
  221.     }
  222.     
  223.     expect {
  224.         -re "(\[^ ]*) 0*(\[^ ]+) \[^\n]*\n" {
  225.             set ng $expect_out(1,string)
  226.             set hi $expect_out(2,string)
  227.             lappend active_list $ng
  228.             set db($ng,hi) $hi
  229.             exp_continue
  230.         }
  231.         ".\r\n" close
  232.         eof
  233.     }
  234.  
  235.     wait
  236.     return 0
  237. }
  238.  
  239. # test in various ways for good newsgroups
  240. # return 1 if good, 0 if not good
  241. # PRIVATE
  242. proc _isgood {ng threshold} {
  243.     global db seen_list ignore_list
  244.  
  245.     # skip if we don't subscribe to it
  246.     if ![info exists db($ng,seen)] {return 0}
  247.  
  248.     # skip if the threshold isn't exceeded
  249.     if {$db($ng,hi) - $db($ng,seen) < $threshold} {return 0}
  250.  
  251.     # skip if it matches an ignore command
  252.     foreach igpat $ignore_list {
  253.         if [string match $igpat $ng] {return 0}
  254.     }
  255.  
  256.     # skip if we've seen it before
  257.     if [lsearch -exact $seen_list $ng]!=-1 {return 0}
  258.  
  259.     # passed all tests, so remember that we've seen it
  260.     lappend seen_list $ng
  261.     return 1
  262. }
  263.  
  264. # return 1 if not seen on previous turn
  265. # PRIVATE
  266. proc _isnew {ng} {
  267.     global previous_seen_list
  268.  
  269.     if [lsearch -exact $previous_seen_list $ng]==-1 {
  270.         return 1
  271.     } else {
  272.         return 0
  273.     }
  274. }
  275.  
  276. # schedule display of newsgroup in global variable "newsgroup"
  277. # PUBLIC
  278. proc display {} {
  279.     global display_list newsgroup
  280.  
  281.     lappend display_list $newsgroup
  282. }
  283.  
  284. # PRIVATE
  285. proc _update_ngs {} {
  286.     global watch_list active_list newsgroup
  287.  
  288.     foreach watch $watch_list {
  289.         set threshold 1
  290.         set display display
  291.         set new {}
  292.  
  293.         set ngpat [lindex $watch 0]
  294.         set watch [lrange $watch 1 end]
  295.  
  296.         while {[llength $watch] > 0} {
  297.             switch -- [lindex $watch 0] \
  298.             -threshold {
  299.                 set threshold [lindex $watch 1]
  300.                 set watch [lrange $watch 2 end]
  301.             } -display {
  302.                 set display [lindex $watch 1]
  303.                 set watch [lrange $watch 2 end]
  304.             } -new {
  305.                 set new [lindex $watch 1]
  306.                 set watch [lrange $watch 2 end]
  307.             } default {
  308.                 _abort "watch: expecting -threshold -display or -new but found: [lindex $watch 0]"
  309.             }
  310.         }
  311.  
  312.         foreach ng $active_list {
  313.             if [string match $ngpat $ng] {
  314.                 if [_isgood $ng $threshold] {
  315.                     if [llength $display] {
  316.                         set newsgroup $ng
  317.                         uplevel $display
  318.                     }
  319.                     if [_isnew $ng] {
  320.                         if [llength $new] {
  321.                             set newsgroup $ng
  322.                             uplevel $new
  323.                         }
  324.                     }
  325.                 }
  326.             }
  327.         }
  328.     }
  329. }
  330.  
  331. # initialize display
  332.  
  333. set min_reasonable_width 8
  334.  
  335. wm minsize . $min_reasonable_width 1
  336. wm maxsize . 999 999
  337. if {0 == [info exists active_file] && 
  338.     0 != [string compare $server $_default_server]} {
  339.     wm title . "news@$server"
  340.     wm iconname . "news@$server"
  341. }
  342.  
  343. # PRIVATE
  344. proc _update_window {} {
  345.     global server display_list height width min_reasonable_width
  346.  
  347.     if {0 == [llength $display_list]} {
  348.         unmapwindow
  349.         return
  350.     }
  351.  
  352.     # make height correspond to length of display_list or
  353.     # user's requested max height, whichever is smaller
  354.     
  355.     if {[llength $display_list] < $height} {
  356.         set current_height [llength $display_list]
  357.     } else {
  358.         set current_height $height
  359.     }
  360.  
  361.     # force reasonable min width
  362.     if {$width < $min_reasonable_width} {
  363.         set width $min_reasonable_width
  364.     }
  365.  
  366.     wm geometry . ${width}x$current_height
  367.     wm maxsize . 999 [llength $display_list]
  368.  
  369.     _display_ngs $width
  370.  
  371.     if [string compare [wm state .] withdrawn]==0 {
  372.         mapwindow
  373.     }
  374. }
  375.  
  376. # actually write all newsgroups to the window
  377. # PRIVATE
  378. proc _display_ngs {width} {
  379.     global db display_list
  380.  
  381.     set str_width [expr $width-7]
  382.  
  383.     .list delete 0 end
  384.     foreach ng $display_list {
  385.         .list insert end [format \
  386.             "%-$str_width.${str_width}s %5d" $ng \
  387.             [expr $db($ng,hi) - $db($ng,seen)]]
  388.     }
  389. }
  390.  
  391. # PUBLIC
  392. proc help {} {
  393.     catch {destroy .help}
  394.     toplevel .help
  395.     message .help.text -aspect 400 -text \
  396. {tknewsbiff - written by Don Libes, NIST, 1/1/94
  397.  
  398. tknewsbiff displays newsgroups with unread articles based on your .newsrc\
  399. and your .tknewsbiff files.\
  400. If no articles are unread, no window is displayed.
  401.  
  402. Click mouse button 1 for this help,\
  403. button 2 to force display to query news server immediately,\
  404. and button 3 to remove window from screen until the next update.
  405.  
  406. Example .tknewsbiff file:}
  407.     message .help.sample -font "*-r-normal-*-m-*" \
  408.     -relief raised -aspect 10000 -text \
  409. {set width    30        ;# max width, defaults to 27
  410. set height    17        ;# max height, defaults to 10
  411. set delay    120        ;# in seconds, defaults to 60
  412. set server    news.nist.gov    ;# defaults to "news"
  413. set server_timeout 60        ;# in seconds, defaults to 60
  414. set newsrc    ~/.newsrc    ;# defaults to ~/.newsrc
  415.                 ;# after trying ~/.newsrc-$server
  416. # Groups to watch.
  417. watch comp.lang.tcl
  418. watch dc.dining        -new "play yumyum"
  419. watch nist.security    -new "exec red-alert"
  420. watch nist.*
  421. watch dc.general    -threshold 5
  422. watch *.sources.*    -threshold 20
  423. watch alt.howard-stern    -threshold 100 -new "play robin"
  424.  
  425. # Groups to ignore (but which match patterns above).
  426. # Note: newsgroups that you don't read are ignored automatically.
  427. ignore *.d
  428. ignore nist.security
  429. ignore nist.sport
  430.  
  431. # Change background color of newsgroup list
  432. .list config -bg honeydew1
  433.  
  434. # Play a sound file
  435. proc play {sound} {
  436.     exec play /usr/local/lib/sounds/$sound.au
  437. }}
  438.     message .help.end -aspect 10000 -text \
  439. "Other customizations are possible.  See man page for more information."
  440.  
  441.     button .help.ok -text "ok" -command {destroy .help}
  442.     pack .help.text
  443.     pack .help.sample
  444.     pack .help.end -anchor w
  445.     pack .help.ok -fill x -padx 2 -pady 2
  446. }
  447.  
  448. spawn cat -u; set _cat_spawn_id $spawn_id
  449. set _update_flag 0
  450.  
  451. # PUBLIC
  452. proc update-now {} {
  453.     global _update_flag _cat_spawn_id
  454.  
  455.     if $_update_flag return    ;# already set, do nothing
  456.     set _update_flag 1
  457.  
  458.     exp_send -i $_cat_spawn_id "\r"
  459. }
  460.  
  461. bind .list <1> help
  462. bind .list <2> update-now
  463. bind .list <3> unmapwindow
  464. bind .list <Configure> {
  465.     scan [wm geometry .] "%%dx%%d" w h
  466.     _display_ngs $w
  467. }
  468.  
  469. # PRIVATE
  470. proc _sleep {timeout} {    
  471.     global _cat_spawn_id _update_flag
  472.  
  473.     set _update_flag 0
  474.  
  475.     # restore to idle cursor
  476.     .list config -cursor ""; update
  477.  
  478.     # sleep for a little while, subject to click from "update" button
  479.     expect -i $_cat_spawn_id -re "...."    ;# two crlfs
  480.  
  481.     # change to busy cursor
  482.     .list config -cursor watch; update
  483. }
  484.  
  485. set previous_seen_list {}
  486. set seen_list {}
  487.  
  488. # PRIVATE
  489. proc _init_ngs {} {
  490.     global display_list db
  491.     global seen_list previous_seen_list
  492.  
  493.     set previous_seen_list $seen_list
  494.  
  495.     set display_list {}
  496.     set seen_list {}
  497.  
  498.     catch {unset db}
  499. }
  500.  
  501. for {} 1 {_sleep $delay} {
  502.     _init_ngs
  503.  
  504.     _read_newsrc
  505.     if [_read_active] continue
  506.     _read_config_file
  507.  
  508.     _update_ngs
  509.     user
  510.     _update_window
  511. }
  512.